package Zim::GUI::Component;

use strict;
use vars qw/$AUTOLOAD/;
use Carp;
use Encode;
use File::BaseDir qw/xdg_data_home xdg_data_dirs xdg_data_files/;
use Zim::File;
use Zim::Utils;
  
our $VERSION = '0.20';
  
($Zim::ICON) = xdg_data_files('pixmaps', 'zim.png');
warn "WARNING: Could not find 'zim.png', is \$XDG_DATA_DIRS set properly ?\n"
	unless length $Zim::ICON;
  
{ # load all icons in pixmaps/zim
 	my @dirs = grep -d $_, map "$_/pixmaps/zim",
 		xdg_data_home, xdg_data_dirs;
	my @files = ($Zim::ICON);
 	for my $d (@dirs) {
		push @files, map $d.'/'.$_, Zim::File->list_dir($d);
	}
	return unless @files;

	my $factory = Gtk2::IconFactory->new;
	$factory->add_default;
	for my $f (@files) {
		my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file($f);
		my $icon_set = Gtk2::IconSet->new_from_pixbuf($pixbuf);
		my $n = $f;
		$n =~ s/.*[\/\\]//;
		$n =~ s/\..*//;
		#warn "Icon: $n => $f\n";
		$factory->add($n => $icon_set);
	}
}

=head1 NAME

Zim::GUI::Component - GUI base class

=head1 SYNOPSIS

FIXME example of a component init using actions etc.

=head1 DESCRIPTION

This class provides a base class for GUI components in zim.
Modules can inherit a number of convenience methods from it.

Most GUI methods expect the C<{app}> attribute to be set.
This aplication object is expected to have attributes
C<{ui}> and C<{window}>.

=head1 METHODS

=over 4

=item C<new(%ATTRIBUTES)>

Simple constructor, calls C<init()>.

=cut

our $_popup_args; # used to pass args to UI popups

sub new {
	my $class = shift;
	my $self = bless {@_}, $class;
	$self->{_block_actions} = 0;
	$self->init();
	return $self;
}

=item C<init()>

Called by the constructor, to be overloaded.

=cut

sub init {};

=item C<widget()>

Returns the "top_widget" attribute. This should be the toplevel widget
for the GUI managed by this object.

=cut

sub widget { $_[0]->{top_widget} }

=item C<AUTOLOAD()>

Autoloader for object methods.

If you have a C<{widget}> attribute in your object this will be
the target for unknown methods.

=cut

sub AUTOLOAD {
	$AUTOLOAD =~ s/^.*:://;
	return if $AUTOLOAD eq 'DESTROY';
	#warn "AUTOLOAD: $AUTOLOAD(@_)\n";
	#warn "AUTOLOAD caller: ", caller(), "\n";
	if ($AUTOLOAD =~ s/^on_(\w+)$/$1/) { # could be an action handler
		my $self = pop;
		return if $self->{_block_actions};
		warn "## dispatch ACTION $AUTOLOAD\n";
		if ($AUTOLOAD =~ s/^popup_//) { # popup menu
			return $self->$AUTOLOAD(
				defined($_popup_args) ? (@$_popup_args) : () );
		}
		else { return $self->$AUTOLOAD() }
	}
	else {
		my $self = shift;
		my $class = ref $self;
		croak "No such method: $class::$AUTOLOAD"
			unless $self->{widget}
			and    $self->{widget}->can($AUTOLOAD);
		return $self->{widget}->$AUTOLOAD(@_);
	}
}

=back

=head2 UI Methods

=over 4

=item C<add_actions($ACTIONS, $TYPE, $NAME)>

Add plain text action descriptions to the interface.

TYPE can be C<undef>, "menu", "toggle" or "radio".

NAME is an optonal group name. This is used to set a single
callback for all actions. If NAME is not defined the callback
for each action will be the name of the action.

=cut

sub add_actions {
	my ($self, $actions, $type, $name) = @_;
	$type = lc $type;
	my $class = ref $self;
	
	unless ($self->{actions}) {
		my $a = Gtk2::ActionGroup->new($class);
		$self->{app}{ui}->insert_action_group($a, 0);
		$self->{actions} = $a;
	}
	return $self->_add_radio_group($actions, $name) if $type eq 'radio';
	
	my @actions;
	for (grep /\S/, split /\n/, $actions) {
		my @a = map {($_ eq '.') ? undef : $_} split /\t+/, $_;
		$a[2] = __($a[2]);
		$a[4] = __($a[4]);
		my $n = $name || $a[0] ;
		push @a, \&{$class.'::on_'.$n} unless $type eq 'menu';
		push @a, '0' if $type eq 'toggle';
		push @actions, \@a;
	};
	#use Data::Dumper; warn "Actions ($type): ", Dumper \@actions;
	
	($type eq 'toggle')
		? $self->{actions}->add_toggle_actions(\@actions, $self)
		: $self->{actions}->add_actions(\@actions, $self)  ;
}

sub _add_radio_group {
	my ($self, $actions, $name) = @_;
	my $class = ref $self;
	
	my @l = grep /\S/, split /\n/, $actions;
	my $val = 0;
	my @actions;
	for (@l) {
		my @a = map {($_ eq '.') ? undef : $_} split /\t+/, $_;
		push @a, $val++;
		push @actions, \@a;
	}
	#use Data::Dumper; warn "Actions (radio): ", Dumper \@actions;

	$self->{actions}->add_radio_actions(
		\@actions, -1, \&{$class.'::on_'.$name}, $self );
}

=item C<get_action($NAME)>

=cut

sub get_action { $_[0]->{actions}->get_action($_[1]) }


=item C<< actions_set_sensitive($NAME => $VAL, ...) >>

Set the sensitivity for one or more actions by name.

=cut

sub actions_set_sensitive {
	my ($self, %actions) = @_;
	for my $name (keys %actions) {
		my $action = $self->{actions}->get_action($name);
        unless ($action) {
            carp "BUG: no such action: $name\n";
            next;
        }
		_gtk_action_set_sensitive($action, $actions{$name});
	}
}

sub _gtk_action_set_sensitive { # **sigh**
	my ($action, $bit) = @_;
	if (Gtk2->CHECK_VERSION(2, 6, 0)) { $action->set_sensitive($bit) }
	else { $_->set_sensitive($bit) for $action->get_proxies }
}

=item C<< actions_set_active($NAME => $VAL, ...) >>

Set the one or more actions active by name.

Used to make the state of the actions match the settings.
When it results in a change of state the handler is called,
which in turn makes the state of the application match the settings.

=cut

sub actions_set_active {
	my ($self, %actions) = @_;
	for my $name (keys %actions) {
		my $action = $self->{actions}->get_action($name);
        unless ($action) {
            carp "BUG: no such action: $name\n";
            next;
        }
		$action->set_active($actions{$name} ? 1 : 0);
	}
}

=item C<< actions_show_active($NAME => $VAL, ..) >>

Like C<actions_set_active()> but prevents the action callback
to be called. This method is used to make the appearance of 
the action match the state of the application.

The blocking works at the level of our AUTOLOAD function.

=cut

sub actions_show_active {
	my $self = shift;
	$self->{_block_actions} = 1;
	$self->actions_set_active(@_);
	#while (Gtk2->events_pending) { Gtk2->main_iteration_do(0) }
	$self->{_block_actions} = 0;
}

=item C<add_ui($UI)>

Add a xml style ui description to the interface.

=cut

sub add_ui { $_[0]->{app}{ui}->add_ui_from_string($_[1]) }

=item C<popup($NAME, $BUTTON, $TIME, @ARGS)>

Popup the menu called NAME from the ui spec.
BUTTON and TIME are passed to C<< Gtk2::Menu->popup() >>.
Any ARGS are forwarded to the actions.

=cut

sub popup {
	my ($self, $name, $button, $time, @args) = @_;
	my $menu = $self->{app}{ui}->get_widget('/'.$name) or return 0;
    unless ($menu) {
        carp "BUG: no such menu: $name";
        return 0;
    }
	$_popup_args = scalar(@args) ? \@args : undef;
	$menu->popup(undef, undef, undef, undef, $button, $time);
	return 1;
}

=back

=head2 Actions

=over 4

=item C<ShowHelp(PAGE)>

Show a window showing the documentation. PAGE is optional.

=cut

sub ShowHelp {
	my ($self, $page) = @_;
	my @args = ('--doc', $page ? $page : ());
	$self->exec_new_window(@args);
}

=back

=head2 Process Methods

=over 4

=item  C<exec_new_window(..)>

Executes a new process for $0, this gives a detached window.
Any arguments are passed on to the new process.

=cut

sub exec_new_window {
	my ($self, @args) = @_;
	Zim::Utils->run($^X, $0, @args);
}

=back

=head2 Helper Methods

=over 4

=item C<check_page_input()>

Checks whether an user input is indeed a page name and not e.g. an url.
Returns a page name or undef.
Page name didn't go through cleanup, so does not need to be valid.

=cut

sub check_page_input {
	my ($self, $name) = @_;
	return undef unless length $name;
	my ($t, $l) = Zim::Formats->parse_link($name, $self->{app}{page});
		# default parse_link(), not page dependent
	return $l if $t eq 'page' and length $l;
	$self->error_dialog(
		"Not a valid page name: $name",
		"Parsing gives type '$t' for page '$name'" );
	return undef;
}

=item C<decode_uri_list(TEXT)>

Method to decode data in the C<text/uri-list> format.
This format is used with drag-drop operations of files etc.
Returns a list of uris.

=item C<encode_uri_list(URI, ...)>

Method to encode data in the C<text/uri-list> format.
This format is used with drag-drop operations of files etc.
Returns ascii text data.

=cut

sub decode_uri_list {
	my (undef, $text) = @_;
	my @uris = grep defined($_), split /[\r\n]+/, $text; # split in lines
	for (@uris) {
		s/\%([A-Fa-z0-9]{2})/chr(hex($1))/eg; # url encoding
		eval {$_ = Encode::decode('utf8', $_, 1)}; # utf8 decoding
	}
	return @uris;
}

sub encode_uri_list {
	my (undef, @uris) = @_;
	for (@uris) {
		$_ = Encode::encode_utf8($_); # utf8 decoding
		$_ =~ s{ ([^A-Za-z0-9\-\_\.\!\~\*\'\(\)\/\:]) }
		       { sprintf("%%%02X",ord($1))            }egx;
		# url encoding - char set from man uri(7), see relevant rfc
		# added '/' and ':' to char set for readability of uris
	}
	return join '', map "$_\r\n", @uris;
}

=item C<new_button(STOCK, TEXT)>

Creates a button with a stock image but different text.

=cut

sub new_button {
	my ($self, $stock, $text) = @_;
	my $hbox = Gtk2::HBox->new;
	$hbox->pack_start(
		Gtk2::Image->new_from_stock($stock, 'button'), 0,0,0);
	$hbox->pack_start(
		Gtk2::Label->new_with_mnemonic($text), 1,1,0);
	my $button = Gtk2::Button->new();
	$button->add(Gtk2::Alignment->new(0.5,0.5, 0,0));
	$button->child->add($hbox);
	return $button;
}

=item C<list_text_targets(INFO)>

Returns a list of targets used to copy-paste or drag-drop text.

=cut

sub list_text_targets {
	map [$_, [], $_[1]],
		qw{UTF8_STRING TEXT COMPOUND_TEXT text/plain} ;
}

=back

=head2 Common Dialogs

=over 4

=item C<new_prompt(TITLE, FIELDS, DATA, BUTTON_STOCK, BUTTON_TEXT, TEXT)>

Generates a dialog asking for one or more fields of input.
Returns the dialog widget and a list with Gtk2::Entry objects.

TITLE is the dialog title.

FIELDS and DATA are used for the C<new_form()> method.

TEXT, BUTTON_STOCK and BUTTON_TEXT are optional.

=cut

sub new_prompt {
	my ($self, $title, $fields, $data, $stock, $string, $text) = @_;
	
	## Setup dialog
	$title =~ s/(\s+\-)?\s*zim\s*$//i;
	$title .= ' - Zim';
	my $dialog = Gtk2::Dialog->new(
		$title, $self->{app}{window},
		[qw/modal destroy-with-parent no-separator/],
		'gtk-cancel'  => 'cancel',
	);
	$dialog->set_resizable(0);
	#$dialog->vbox->set_border_width(12); # FIXME
	$dialog->set_icon($self->{app}{window}->get_icon);
	
	$stock ||= 'gtk-ok';
	my $button = $string
		? $self->new_button($stock, $string)
		: Gtk2::Button->new_from_stock($stock);
	$dialog->add_action_widget($button, 'ok');
	# $dialog->set_default_response('ok'); FIXME

	if (defined $text) {
		my $label = Gtk2::Label->new();
		$label->set_markup($text);
		my $align = Gtk2::Alignment->new(0,0.5, 0,0);
		$align->add($label);
		$dialog->vbox->add($align);
	}
	
	my ($table, $entries) = $self->new_form($fields, $data, $dialog);
	$dialog->vbox->add($table);

	$dialog->show_all;
	return $dialog, $entries;
}

=item C<new_form(FIELDS, DATA, DIALOG)>

FIELDS is an array ref giving the order of the input fields.

DATA is a hash ref containing definitions of the input fields.
The key is the name used in FIELDS, the value an array ref with a label text,
a data type and a value.
At the moment only the "string", "page", "file" and "dir" data types are
treated special, all other will be ignored silently.

DIALOG is optional and will be used to connect signals.

=cut

sub new_form {
	my ($self, $fields, $data, $dialog) = @_;

	my $table = Gtk2::Table->new(scalar(@$fields), 2);
	$table->set_border_width(5);
	$table->set_row_spacings(5);
	$table->set_col_spacings(12);

	my @entries;
	for my $i (0 .. $#$fields) {
		my @f = @{ $$data{$$fields[$i]} };
		
		my $label = Gtk2::Label->new($f[0].':');
		my $align = Gtk2::Alignment->new(0,0.5, 0,0);
		$align->add($label);
		
		my $entry = Gtk2::Entry->new();
		$entry->set_text($f[2]) if defined $f[2];
		push @entries, $entry;
		
		$table->attach_defaults($align, 0,1, $i,$i+1);

		if ($f[1] eq 'file' or $f[1] eq 'dir') {
			my $hbox = Gtk2::HBox->new(0,3);
			$hbox->add($entry);

			my $is_dir = ($f[1] eq 'dir');
			my $button = Gtk2::Button->new('_Browse...');
			$button->signal_connect( clicked => sub {
				my $val = $entry->get_text();
				$val = File::Spec->rel2abs('./___')
					if $is_dir and ! length $val;
					# force current dir instead of parent
				$val = $self->filechooser_dialog($val, $is_dir);
				$entry->set_text($val);
			} );
			$hbox->pack_start($button, 0,1,0);

			$table->attach_defaults($hbox, 1,2, $i,$i+1);
		}
		elsif ($f[1] eq 'page') {
			$self->set_page_completion($entry);
			$table->attach_defaults($entry, 1,2, $i,$i+1);
		}
		elsif ($f[1] eq 'password') {
			$entry->set_visibility(0);
			$table->attach_defaults($entry, 1,2, $i,$i+1);
		}
		else {
			$table->attach_defaults($entry, 1,2, $i,$i+1);
		}
	}
	
	for my $i (0 .. $#entries - 1) {
		$entries[$i]->signal_connect(
			activate => sub { $entries[$i+1]->grab_focus } );
	}
	if ($dialog) {
		$entries[-1]->signal_connect(
			activate => sub { $dialog->response('ok') } );
	}

	return ($table, \@entries);
}

=item C<set_page_completion(ENTRY)>

Attach page completions code to a L<Gtk2::Entry> object.

=cut

sub set_page_completion {
	my ($self, $entry) = @_;
	my $completion = Gtk2::EntryCompletion->new;
	my $model = Gtk2::ListStore->new('Glib::String');
	$completion->set_model($model);
	$completion->set_text_column(0);
	$completion->set_inline_completion(1)  if Gtk2->CHECK_VERSION(2, 6, 0);
	$entry->set_completion($completion);
	$entry->signal_connect(changed => \&_update_completion, $self);
}

sub _update_completion {
	my ($entry, $self) = @_;
	return unless $self->{app}{repository} and $self->{app}{page};
	my $ns = $entry->get_text;
	$ns =~ s/[^:]+$//;
	return if defined $entry->{_ns} and $entry->{_ns} eq $ns;
	$entry->{_ns} = $ns;
	
	my $_ns = length($ns)
		? $self->{app}{repository}->resolve_namespace($ns)
		: $self->{app}{page}->namespace() ;
		#warn "Complete namespace: $_ns\n";
	
	my $model = $entry->get_completion->get_model;
	$model->clear;
	for ($self->{app}{repository}->list_pages($_ns)) {
		s/_/ /g;
		my $iter = $model->append();
		$model->set($iter, 0 => $ns.$_);
		#warn "Appended: $ns$_\n";
	}
}

=item C<run_prompt(..)>

Wrapper around C<new_prompt()> that runs the dialog and
returns a list with input values. Returns undef on 'cancel'.

=cut

sub run_prompt {
	my $self = shift;
	my ($dialog, $entries) = $self->new_prompt(@_);

	my $values = ($dialog->run eq 'ok')
		? [map $_->get_text, @$entries]
		: undef ;
	$dialog->destroy;

	return $values;
}

=item C<prompt_question(TITLE, TYPE, TEXT, BUTTONS ..., TIME)>

Runs a dialog displaying TEXT

BUTTONS is a list of array references, each containing a name, a stock item
name and/or text. The id of the button that was pressed is returned.

TYPE can either be 'error', 'warning', 'question', 'info' or C<undef>.

TIME is an optional argument, it gives a timeout in seconds. This is used
for popups that can popup while the user is typing to prevent accidental
triggering of a accelerator.

=cut

sub prompt_question {
	my ($self, $title, $type, $text, @buttons) = @_;
	my $time = pop @buttons unless ref $buttons[-1];
	
	$title =~ s/(\s+\-)?\s*zim\s*$//i;
	$title .= ' - Zim';
	my $dialog = Gtk2::Dialog->new(
		$title, $self->{app}{window},
	       	[qw/modal destroy-with-parent no-separator/],
	);
	$dialog->set_resizable(0);
	$dialog->set_icon($self->{app}{window}->get_icon);

	my @button_widgets;
	for (0 .. $#buttons) {
		my ($id, $stock, $string) = @{$buttons[$_]};
		my $button = (defined($stock) && ! defined($string))
			? Gtk2::Button->new_from_stock($stock)
			: $self->new_button($stock, $string)   ;
		$button->set_sensitive(0);
		$dialog->add_action_widget($button, $_);
		push @button_widgets, $button;
	}
	
	my $hbox = Gtk2::HBox->new(0,12);
	$hbox->set_border_width(12);
	$dialog->vbox->pack_start($hbox, 0,0,0);

	if (defined $type) {
		my $image = Gtk2::Image->new_from_stock(
			"gtk-dialog-$type", 'dialog' );
		$image->set_alignment(0.0, 0.5); # valign=top
		$hbox->pack_start($image, 0,0,0);
	}
	if (defined $text) {
		my $label = Gtk2::Label->new($text);
		$label->set_use_markup(1);
		$label->set_selectable(1);
		$label->set_alignment(0.0, 0.0); # align left top corner
		$hbox->add($label);
	}

	$dialog->show_all;
	if ($time) {
		Glib::Timeout->add( $time*1000,
			sub { $_->set_sensitive(1) for @button_widgets; 0 } );
	}
	else { $_->set_sensitive(1) for @button_widgets }
	my $id = $dialog->run;
	$dialog->destroy;
	
	return $buttons[$id][0];
}

=item C<exit_error(ERROR)>

Like C<error_dialog> but exits afterwards.

=cut

sub exit_error {
	my $self = shift;
	my ($text1, $text2) = @_;
	if (defined $text1) { $self->error_dialog($text1, $text2) }
	else {
		$text2 ||= "Unknown error";
		warn "zim: $text2\n";
	}
	unlink $self->{app}{pidfile}
		if ref $self and defined $self->{app}{pidfile};
	exit 1;
}

=item C<error_dialog(ERROR)>

This method is used to display errors.

=cut

sub error_dialog {
	my ($self, $text1, $text2) = @_;
	$text2 ||= $@ || $text1;
	warn "zim: $text2\n";
	$text1 =~ s/\%/%%/g; # MessageDialog uses sprintf interface
	my $window = $self->{app}{window} if ref $self;
	$window = undef unless defined $window and $window->visible;
		# window might not yet be realized
	my $dialog = Gtk2::MessageDialog->new(
		# no markup, $@ can contain "<" symbols
		$window, 'modal', 'error', 'ok', $text1 );
		# parent, flags, type, buttons, message
	$dialog->run;
	$dialog->destroy;
	return undef;
}

=item C<filechooser_dialog(FILE)>

Ask the user for a filename. FILE is the suggested filename.

=cut

sub filechooser_dialog {
	my ($self, $file, $dir, $title) = @_;
	
	my $dialog;
	$title ||= $dir ? 'Select Folder' : 'Select File' ;
	# if (Gtk2->CHECK_VERSION(2, 4, 0) and $Gtk2::VERSION >= 1.040) {
	$dialog = Gtk2::FileChooserDialog->new(
		$title, $self->{app}{window}, 'open',
		'gtk-cancel' => 'cancel',
		'gtk-ok'     => 'ok'
	);
	# }
	#else { # old & ugly interface
	#	$dialog = Gtk2::FileSelection->new($title);
	#}
	$dialog->set_icon($self->{app}{window}->get_icon);
	$dialog->set_action('select-folder') if $dir;
	if (defined $file) {
		$file = Zim::File->localize(
				Zim::File->abs_path($file) );
		$dialog->set_filename($file);
	}
	elsif (defined $self->{app}{page}) {
		my $dir = $self->{app}{page}->properties->{base};
		if (defined $dir) {
			$dir = Zim::File->localize(
				Zim::File->abs_path($dir) );
			$dialog->set_current_folder($dir);
		}
	}
	$dialog->signal_connect('response', sub {
		$file = $_[1] eq 'ok' ? $dialog->get_filename : undef;
		$dialog->destroy;
	} );
	$dialog->run;

	return $file;
}

=item C<new_progress_bar(TITLE, LABEL)>

Returns a dialog with a progress bar.

=cut

sub new_progress_bar {
	my ($self, $title, $label) = @_;
	my $dialog = Gtk2::Dialog->new(
		$title, $self->{window},
	   	[qw/destroy-with-parent no-separator/],
		'gtk-cancel' => 'cancel',
	);
	$dialog->set_resizable(0);
	$dialog->vbox->set_spacing(5);
	$dialog->vbox->set_border_width(10);
	$label = Gtk2::Label->new($label);
	$dialog->vbox->add($label);
	my $bar = Gtk2::ProgressBar->new;
	$dialog->vbox->add($bar);
	$dialog->show_all;
	return ($dialog, $bar, $label);
}

1;

__END__

=back

=head1 AUTHOR

Jaap Karssenberg (Pardus) E<lt>pardus@cpan.orgE<gt>

Copyright (c) 2006 Jaap G Karssenberg. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

=cut

